home *** CD-ROM | disk | FTP | other *** search
/ Amiga Collections: MegaDisc / MegaDisc 41 (1994-09)(MegaDisc Digital Publishing)(AU)(Disk 2 of 2).zip / MegaDisc 41 (1994-09)(MegaDisc Digital Publishing)(AU)(Disk 2 of 2).adf / ARexx_&_HBook / MiniLinks / MiniLinks.rexx < prev    next >
OS/2 REXX Batch file  |  1994-08-09  |  10KB  |  273 lines
  1.     /*                                                   */
  2.     /*         MiniLinks - a kind of hypertext           */
  3.  
  4.     /*   By John Collett                   August 1994   */
  5.  
  6.     /*   Written in ARexx.  Needs 'rexxarplib.library'.  */
  7.  
  8.     /* Various commands possible if run from CLI :
  9.     
  10.     1  rx MiniLinks                   (or if run from an icon)
  11.     2  rx MiniLinks FileNameN
  12.     3  rx MiniLinks FileNameN xy
  13.     4  rx MiniLinks FileNameN Anything_but_xy
  14.     
  15.     1  The program will screen Script1.
  16.     2  The program will screen FileNameN.
  17.     3  The program will screen FileNameN.  Pointer position updates will
  18.        be available for screen planning, but text links will be inoperative.
  19.     4  Program will close screen and exit - handy for getting out of a fix.
  20.     */
  21.  
  22.     signal on syntax ; signal on error
  23.  
  24.     if ~show('l','rexxarplib.library') then do
  25.      check = addlib('rexxsupport.library',0,-30,0) 
  26.      check = addlib('rexxarplib.library',0,-30,0) 
  27.      end          
  28.  
  29.     xy = 0 ;  parse arg choice s .
  30.     if s ~= '' then if s ~= 'xy' then signal 'Finish' ; else xy = 1
  31.  
  32.             /*  Create window */
  33.                                 
  34.     address AREXX '"call CreateHost(HO, PORT)"'    
  35.     if ~show('Ports',HO) then address command 'WaitForPort HO' 
  36.     /*flags = 'WINDOWCLOSE + WINDOWDEPTH + WINDOWDRAG + WINDOWSIZING'*/
  37.     flags = 'BORDERLESS+WINDOWCLOSE'
  38.     idcmp = 'CLOSEWINDOW + GADGETUP + MOUSEBUTTONS + RAWKEY'
  39.     foot = 256 ; call OpenWindow(HO,0,0,640,foot,idcmp, flags) 
  40.     call openport(PORT) ; call ActivateWindow(HO)
  41.  
  42.     /* Set colours */ 
  43.     c.0 = '6 9 13' ; c.1 = '0 0 2' ; c.2 = '15 15 15' ; c.3 = '15 9 4'
  44.     c.4 = '14 1 1' ; c.5 = '0 15 0' ; c.6 = '0 0 11' ; c.7 = '15 15 0'
  45.     do i = 0 to 7 ; parse var c.i r g b . ; call SetRGB4(HO,i,r,g,b) ; end
  46.  
  47.     call ModifyHost(HO,'MOUSEBUTTONS','%l %b %x %y')
  48.     call ModifyHost(HO,'RAWKEY','%l %c')
  49.  
  50.     /*  Gadgets to get previous page, next page, and new script set */
  51.  
  52.     call AddGadget(HO,564,1,1,'<-','%l %d')
  53.     call AddGadget(HO,588,1,2,'->','%l %d')
  54.     call AddGadget(HO,612,1,3,'??','%l %d')
  55.     gadno = 0
  56.  
  57.     /* Does the default script set exist? If not, use a file requester. */
  58.     if choice ~= '' then call Analyze(choice)
  59.     else do
  60.      ok = exists("Script1")
  61.      if ok then do                     
  62.       scriptname = 'Script' ; scriptno = 1 
  63.       script = scriptname || scriptno ; end
  64.      else call GetName()
  65.      if scriptname = '' then signal 'Finish'
  66.      end
  67.  
  68.     /* Scripts after the first : up/down in series, or new set? */
  69.  
  70.     GetScript:  
  71.     call clear(2)
  72.     if gadno = 2 then scriptno = scriptno + 1 
  73.     else if gadno = 1 & scriptno > 1 then scriptno = scriptno - 1 
  74.      script = scriptname || scriptno 
  75.     ok = exists(script)
  76.     if (~ok) | gadno = 3 then do
  77.      call GetName() ; if scriptname = '' then signal 'Finish'
  78.      end
  79.  
  80.     /* Load in main text */
  81.                          
  82.     op = open(sc,script,'r') ; if op = 0 then signal 'Finish'
  83.     call clear(1) ; str = '' ; i = 0 
  84.     do forever  
  85.      i = i + 1 ; s.i = readln(sc) ; if strip(s.i) = '<' then leave
  86.      str = str || s.i || '\' 
  87.      end
  88.     call WindowText(HO,compress(str,'`')) ; gadpos = (i+3) * 9
  89.     call pat(30,7,script)
  90.  
  91.     /* Read in the comments on each highlighted chunk. */ 
  92.  
  93.     wc = 0 ; word. = '' ; x1. = 0 ; x2. = 0 ; y. = 0
  94.     do j = 1 to i
  95.      call Underline(s.j) ; s.j = compress(s.j,'`')
  96.     end
  97.  
  98.     /*  Concatenate multi-line comments into a single string,
  99.         including '\' at each line break, until they are needed. */
  100.  
  101.     do c = 1 to wc
  102.      comment.c = ''
  103.      do forever 
  104.       patch = readln(sc) ; if strip(patch) = '' | eof(sc) then leave
  105.       comment.c = comment.c || patch || '\'
  106.       end
  107.      end
  108.  
  109.     /* 'Interpret' any remaining lines - graphics etc.  */
  110.  
  111.     if ~eof(sc) then do until eof(sc)
  112.      instruction = readln(sc)
  113.      interpret instruction
  114.      end
  115.     
  116.     cl = close(sc) ; call pat(260,gadpos,'Ready',1) ; call SetDrMd(HO,JAM1)
  117.     call pat(258,gadpos-1,'Ready',2) ; call APen(1) ; call SetDrMd(HO,JAM2)
  118.  
  119.     /* Screen ready for use. Clicks can be on the 'Close' gadget, next or
  120.        previous page gadget, new script gadget, or an underlined chunk. */
  121.          
  122.     do forever                               
  123.       call waitpkt(PORT) ; p = getpkt(PORT)
  124.       if p ~== NULL() then do
  125.         i = getarg(p) ; t = reply(p, 0)
  126.         parse var i class gadno rest
  127.         select
  128.           when class = 'CLOSEWINDOW' then signal 'Finish'
  129.           when class = 'GADGETUP' then signal 'GetScript'
  130.           when class = 'RAWKEY' & (gadno < 80) then do 
  131.             gadno = 80-gadno ; signal 'GetScript' ; end
  132.           when class = 'MOUSEBUTTONS' then call WordClick()
  133.           otherwise
  134.           end  /* of 'select'         */
  135.         end    /* of 'if ... then do' */
  136.       end      /* of 'do forever'     */
  137.   
  138.     Finish:
  139.       call CloseWindow(HO) ; exit
  140.       syntax: say 'Syntax : ' errortext(rc) '. Line 'sigl ; signal 'Finish'
  141.       error: say "Error " rc sigl ; signal 'Finish'
  142.  
  143.     GetName:                        /* User selects own script set */
  144.      choice = GetFile(150,30,,,'Select a script')
  145.      if choice = '' then signal 'Finish'
  146.      call Analyze(choice)
  147.      return
  148.  
  149.     Analyze:
  150.     /* Extract name and number from choice. */
  151.       choice = arg(1)
  152.       do c = length(choice) to 1 by -1
  153.        char = substr(choice,c,1) ; if datatype(char,'m') then leave
  154.        end
  155.       if c = length(choice) then do
  156.        aa = "Files in script sets must be made\up of a name and a number.",
  157.             "\Default set is Script1, Script2, etc.",
  158.             "\Select Cancel in the next file",
  159.             "\requester if you want to quit." 
  160.        call clear(2) ; r = Request(50,50,aa,,'Okay')
  161.        call GetName()
  162.        end         /* of 'if c = ...' */
  163.       else call Divide()
  164.       return
  165.  
  166.     Divide:                /* Divide choice into name and number */
  167.      scriptname = substr(choice,1,c)
  168.      scriptno = substr(choice,c+1,length(choice)-c)
  169.      script = scriptname || scriptno
  170.      return   
  171.     
  172.     /* Underline chunks which are marked `thus`. */
  173.  
  174.     Underline:
  175.     st = arg(1) ; find = 1 ; call Apen(2)
  176.     do forever
  177.      a1 = -1 ; aa = 1 ; adj = 0
  178.      do until a1 = 0
  179.       a1 = index(st,"`",aa) ; if a1 = 0 then leave
  180.       a2 = index(st,"`",a1+1)    /* Find partner/next space/end of line. */
  181.       if a2 = 0 then do  
  182.         a2 = index(st," ",a1+1) 
  183.         if a2 = 0 then a2 = length(st)+1
  184.         end    
  185.       wc = wc + 1 ; adj = adj + 1    /* Adjust text when markers removed */
  186.       w = substr(st,a1+1,a2-a1-1)   
  187.       word = strip(w,'t','.,?!";:')                /* Remove punctuation */
  188.       if length(w) ~= length(word) then a2 = a2 - 1
  189.       word.wc = word ; x1.wc = a1*8 + 28 - adj*16
  190.       x2.wc = x1.wc + length(word)*8 ; y.wc = (j+2)*9
  191.       call Move(HO,x1.wc,y.wc) ; call Draw(HO,x2.wc,y.wc)
  192.       aa = a2 + 1 
  193.       end
  194.     return
  195.     
  196.     /* Was the click on an underlined chunk? */
  197.  
  198.     WordClick:
  199.       parse var i class state x y 
  200.       if state = 'SELECTUP' then return
  201.       if xy = 1 then do ; call pat(230,8,x y ' ') ; return ; end
  202.       found = 0 ; n = 0
  203.       do until found | (n = wc) 
  204.         n = n + 1 
  205.         found = ((x > x1.n) & (x < x2.n) & (y > y.n-9) & (y < y.n))
  206.         end
  207.       if ~found then return
  208.       call Apen(3) ; call Move(HO,x1.n,y.n -1)
  209.       call Draw(HO,x2.n,y.n -1) ; call APen(1) 
  210.     
  211.       /* Redivide comment into line segments. Center on longest seg. */
  212.  
  213.       thisy = gadpos ; cmt = comment.n ; lin. = '' ; m = 0 ; max = 0
  214.       do forever
  215.         m = m + 1 ; slash = index(cmt,'\') 
  216.         if slash = 0 then do 
  217.            lin.m = cmt ; max = max(max,length(cmt)) ; leave ; end
  218.         lin.m = substr(cmt,1,slash-1) ; max = max(max,length(lin.m))
  219.         cmt = substr(cmt,slash+1,length(cmt)-slash)
  220.         end 
  221.  
  222.       /* Position comment box below end of main text (if room) */
  223.       thisx = (620 - max*8) % 2
  224.       if gadpos+m*8-4 < foot then do
  225.        call clear(3) ; m = m - 1
  226.        call NoteBox(thisx-8,gadpos-8,thisx+max*8+8,gadpos+m*8-4)
  227.        call SetBPen(HO,2)
  228.        do p = 1 to m ; call pat(thisx,thisy,lin.p) ; thisy = thisy + 8 ; end
  229.        call SetBPen(HO,0)
  230.        end
  231.       else do
  232.        com = strip(comment.n,'t','\') 
  233.        call clear(1) ; req = Request(thisx-8,foot - 30 - 9*m,com,,)
  234.        call clear(1) ; call pat(30,7,script)
  235.        end
  236.      return
  237.  
  238.     /* Remaining functions are just useful shortcuts for various jobs */
  239.  
  240.    clear: 
  241.     call APen(0)
  242.     select
  243.      when arg(1) = 1 then call RectFill(HO,20,1,640,10)
  244.      when arg(1) = 2 then call RectFill(HO,0,0,640,foot)
  245.      otherwise call RectFill(HO,0,gadpos-9,640,foot)
  246.      end
  247.     call APen(1) ; call RefreshGadgets(HO) ; return
  248.      
  249.     NoteBox: parse arg lf,up,rt,bot . ; 
  250.      call APen(1) ; call RectFill(HO,lf,up,rt,bot)
  251.      call APen(2) ; call RectFill(HO,lf+2,up+1,rt-2,bot-1) ; call APen(1)
  252.     return
  253.  
  254.     pat:       
  255.       if arg() = 4 then call APen(arg(4))
  256.       call Move(HO,arg(1),arg(2)) ; call Text(HO,arg(3))
  257.      return
  258.  
  259.     APen: call SetAPen(HO,arg(1)) ; return
  260.    
  261.     Rect:
  262.      parse arg lf,up,rt,bot,edge1,edge2 . ; call SetAPen(HO,edge1)
  263.      call Move(HO,lf,up) ; call Draw(HO,rt,up)    
  264.      call SetAPen(HO,edge2) ; call Move(HO,lf,bot) ; call Draw(HO,rt,bot)     
  265.      do u = 0 to 1 ; call Move(HO,rt-u,up+u) ; call Draw(HO,rt-u,bot) ; end 
  266.      call SetAPen(HO,edge1)
  267.      do u = 0 to 1 ; call Move(HO,lf+u,bot-u) ; call Draw(HO,lf+u,up) ; end 
  268.      call SetAPen(HO,1)
  269.      return
  270.  
  271.  
  272.     -----------    Hamilton, New Zealand    August 1944   ----------
  273.